package percentile;

require Exporter;
use strict;
use warnings;


our @ISA = qw(Exporter);
our $VERSION = 1.00;
our @EXPORT = qw(	
					get_percentile
					quartiles
					median
					percentiles
				);


#_________________________________________________________________________________________
#
#	median
#
#_________________________________________________________________________________________
sub get_percentile(\@$)
{
	my ($sorted_array, $percentile) =@_;
	if ($percentile == 0)
	{
		return $sorted_array->[0];
	}
	if ($percentile == 1)
	{
		return $sorted_array->[-1];
	}
	my $rank = $percentile * (scalar @$sorted_array  + 1);
	my $int_rank = int($rank) - 1 ;
	#print STDERR $rank, " / ";
	#print STDERR $int_rank, " : ";
	#print STDERR $sorted_array->[$int_rank], " ?? ";
	#die if ($int_rank + 1) >= @$sorted_array;
	if ($rank - $int_rank - 1 < 1e-8)
	{
	#	print STDERR "\n";
		return ($sorted_array->[$int_rank]);
	}
	#print STDERR ($rank - $int_rank - 1) * ($sorted_array->[$int_rank+1] - $sorted_array->[$int_rank]), "\n";
	return ($sorted_array->[$int_rank] + 
				($rank - $int_rank - 1) * ($sorted_array->[$int_rank + 1] - $sorted_array->[$int_rank]));
}

sub quartiles(\@)
{
	my @list = sort {$a <=> $b} @{$_[0]};
	if (!@list)
	{
		return undef;
	}

	# odd number. use middle value
	return [
		get_percentile(@list, 0.25),
		get_percentile(@list, 0.50),
		get_percentile(@list, 0.75)];
	
	
}

sub median(\@)
{
	my @list = sort {$a <=> $b} @{$_[0]};
	if (!@list)
	{
		return undef;
	}

	# odd number. use middle value
	return get_percentile(@list, 0.50);
}

sub percentiles(\@)
{
	my @list = sort {$a <=> $b} @{$_[0]};
	if (!@list)
	{
		return undef;
	}

	my @results;
	for my $percent(0..100)
	{
		push(@results, get_percentile(@list, $percent * 0.01));
	}
	return [@results];
}


sub test()
{
	my @array = map {$_ * 0.01;} (1..999);
	my $quart = quartiles(@array);
	print STDERR join (", ", @$quart), "\n";
	my $percent = percentiles(@array);
	print STDERR join (", ", @$percent), "\n";
	
}
#test();
1;
